home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / glibmm-2.4 / proc / pm / Property.pm < prev    next >
Encoding:
Perl POD Document  |  2006-04-20  |  2.4 KB  |  120 lines
  1. package Property;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. BEGIN {
  7.      use Exporter   ();
  8.      our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  9.  
  10.      # set the version for version checking
  11.      $VERSION     = 1.00;
  12.      @ISA         = qw(Exporter);
  13.      @EXPORT      = qw(&func1 &func2 &func4);
  14.      %EXPORT_TAGS = ( );
  15.      # your exported package globals go here,
  16.      # as well as any optionally exported functions
  17.      @EXPORT_OK   = qw($Var1 %Hashit &func3);
  18.      }
  19. our @EXPORT_OK;
  20.  
  21. # class Property
  22. #    {
  23. #       string name;
  24. #       string class;
  25. #       string type;
  26. #       bool readable;
  27. #       bool writable;
  28. #       bool construct_only;
  29. #       string docs;
  30. #    }
  31.  
  32.  
  33. sub new
  34. {
  35.   my ($def) = @_;
  36.   my $self = {};
  37.   bless $self;
  38.  
  39.   $def=~s/^\(//;
  40.   $def=~s/\)$//;
  41.   # snarf down the fields
  42.   $$self{mark} = 0;
  43.   $$self{name} = $1                     if ($def =~ s/^define-property (\S+)//);
  44.   $$self{class} = $1                    if ($def =~ s/\(of-object "(\S+)"\)//);
  45.   $$self{type} = $1                     if ($def =~ s/\(prop-type "(\S+)"\)//);
  46.   $$self{readable} = ($1 eq "#t")       if ($def =~ s/\(readable (\S+)\)//);
  47.   $$self{writable} = ($1 eq "#t")       if ($def =~ s/\(writable (\S+)\)//);
  48.   $$self{construct_only} = ($1 eq "#t") if ($def =~ s/\(construct-only (\S+)\)//);
  49.   
  50.   # Property documentation:
  51.   my $propertydocs = $1                     if ($def =~ s/\(docs "([^"]*)"\)//);
  52.   # Add a full-stop if there is not one already:
  53.   if(defined($propertydocs))
  54.   {
  55.     my $docslen = length($propertydocs);
  56.     if($docslen)
  57.     {
  58.       if( !(substr($propertydocs, $docslen - 1, 1) eq ".") )
  59.       {
  60.         $propertydocs = $propertydocs . ".";
  61.       }
  62.     }
  63.   }
  64.   
  65.   $$self{docs} = $propertydocs;
  66.   
  67.  
  68.   $$self{name} =~ s/-/_/g; # change - to _
  69.  
  70.   GtkDefs::error("Unhandled property def ($def) in $$self{class}\::$$self{name}\n")
  71.     if ($def !~ /^\s*$/);
  72.  
  73.   return $self;
  74. }
  75.  
  76. sub dump($)
  77. {
  78.   my ($self) = @_;
  79.  
  80.   print "<property>\n";
  81.  
  82.   foreach (keys %$self)
  83.   { print "  <$_ value=\"$$self{$_}\"/>\n"; }
  84.  
  85.   print "</property>\n\n";
  86. }
  87.  
  88. sub get_construct_only($)
  89. {
  90.   my ($self) = @_;
  91.   return $$self{construct_only};
  92. }
  93.  
  94. sub get_type($)
  95. {
  96.   my ($self) = @_;
  97.   return $$self{type};
  98. }
  99.  
  100. sub get_readable($)
  101. {
  102.   my ($self) = @_;
  103.   return $$self{readable};
  104. }
  105.  
  106. sub get_writable($)
  107. {
  108.   my ($self) = @_;
  109.   return $$self{writable};
  110. }
  111.  
  112. sub get_docs($)
  113. {
  114.   my ($self) = @_;
  115.   return $$self{docs};
  116. }
  117.  
  118.  
  119. 1; # indicate proper module load.
  120.